home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Video Toaster 4.3
/
Video Toaster v4.3.iso
/
3.1
/
toasterall
/
arexx_examples
/
lwm
/
text.lwm
< prev
next >
Wrap
Text File
|
1993-06-08
|
6KB
|
274 lines
/* CMD: Text
* By Arnie Cachelin © 1993 NewTek Inc. */
/* Mon May 31 15:53:20 1993 */
libadd = addlib("LWModelerARexx.port",0)
signal on error
signal on syntax
call addlib "rexxsupport.library", 0, -30, 0
MATHLIB="rexxmathlib.library"
IF POS(MATHLIB , SHOW('L')) = 0 THEN
IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
call notify(1,"!Can't find "MATHLIB)
exit
END
sysnam = 'Compose Text Lines'
filnam = 'ENV:Text.state'
version = 'Text v1.0'
lead=50
typ=1
just=1
deep = 0.1
wide = 0.02
lines=4
line.=""
if (exists(filnam)) then do
if (~open(state, filnam, 'R')) then break
if (readln(state) ~= version) then break
parse value readln(state) with lead typ just .
do i=1 to lines
line.i = readln(state)
end
call close state
end
call req_begin sysnam
styles = 'Flat Block Chisel Round'
id_font = req_addcontrol("Font", 'F')
id_typ = req_addcontrol("Text Type", "CH",Styles)
id_just = req_addcontrol('Place','CH',"Center Left Right Justify Scale")
id_deep = req_addcontrol("Depth", 'n', 1)
id_wide = req_addcontrol("Edge Width", 'n', 1)
do i=1 to lines
id_line.i = req_addcontrol("> ", 's', 35)
end
id_lead = req_addcontrol("% Leading", 'n')
do i=1 to lines
call req_setval id_line.i, line.i
end
line.i=""
call req_setval id_lead, lead,lead
call req_setval id_just, just,1
call req_setval id_typ, typ,1
call req_setval id_deep, deep,0.1
call req_setval id_wide, wide,0.02
if (~req_post()) then do
call req_end
exit
end
LineLen=0
font = req_getval(id_font)
do i=1 to lines
line.i = req_getval(id_line.i)
if length(line.i)>LineLen then do
LineLen=length(line.i)
longest=line.i
end
end
lead = req_getval(id_lead)%1
just = req_getval(id_just)-1
typ = req_getval(id_typ)
wide = req_getval(id_wide)
deep = req_getval(id_deep)
call req_end
if (open(state, filnam, 'W')) then do
call writeln state, version
call writeln state, lead typ just+1
do i=1 to lines
call writeln state, line.i
end
call close state
end
if LineLen=0 then exit
call CUT()
if font=0 then do
if(notify(2,"!Please Load A Font!","I can't continue without one")) then do
fname=GetFileName("Load Font","/ToasterFonts")
if fname~="(none)" then do
font=fontload(fname)
if font=0 then do
call notify(1,"!Can't load font "fname)
exit
end
end
end
end
LineWidth=MAKETEXT(longest,font,'B',wide*2)
if LineWidth~=0 then call UNDO()
call PASTE()
/* call surface(surf) */
/* call meter_begin lines+2, "Creating Formatted Text Object" */
/* call meter_step() */
h=CreateText(line.1, typ,just)
stmarg=h + lead*h/100
do i=2 to lines
/* call meter_step() */
if line.i~="" then do
say i h lead typ
marg=h + lead*h/100
if type=4 then call MOVE(0 marg 0)
else call MOVE(0 stmarg 0)
h=CreateText(line.i, typ)
say h
end
end
box=boundingbox()
parse var box n x1 x2 y1 y2 z1 z2
call MOVE(0 0-y1 0)
/* call meter_end() */
if (libadd) then call remlib("LWModelerARexx.port")
exit
syntax:
error:
call end_all
t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
if (libadd) then call remlib("LWModelerARexx.port")
exit
Center: Procedure
box=boundingbox() /* Should check out empty list ... */
parse var box n x1 x2 y1 y2 z1 z2
cx=-(x2-x1)/2
cy=-(y2-y1)/2
cz=-(z2-z1)/2
call MOVE(cx cy cz)
return box
CenterX: Procedure
box=boundingbox() /* Should check out empty list ... */
parse var box n x1 x2 y1 y2 z1 z2
cx=-(x2-x1)/2
call MOVE(cx 0 0)
return (y2-y1) /* Height */
CenterScaleX: Procedure
arg w
box=boundingbox() /* Should check out empty list ... */
parse var box n x1 x2 y1 y2 z1 z2
cx=-(x2-x1)/2
call MOVE(cx 0 0)
call SCALE(w/2*cx 1 1,0)
return (y2-y1) /* Height */
JustifyX: Procedure expose marg /* 0=center, left=1, 2=right 3=justify 4=Aspect Justify*/
arg w, type
say w type
box=boundingbox() /* Should check out empty list ... */
parse var box n x1 x2 y1 y2 z1 z2
cx=-(x2-x1)/2
cy=(y2-y1)/2
select
when type=4 then do
call MOVE(cx 0 0)
call SCALE(w/(-2*cx) w/(-2*cx) 1,0 y2 0)
end
when type=3 then do
call MOVE(cx 0 0)
call SCALE(w/(-2*cx) 1 1,0)
end
when type=2 then call MOVE(2*cx 0 0)
when type=0 then call MOVE(cx 0 0)
otherwise nop
end
if type=4 then return (y2-y1)*w/(-2*cx) /* Height */
else return (y2-y1)
Bevel_Slab:
txlayer=curlayer()
empty=emptylayers()
if empty~="" then do
slablayer=word(empty,1)
end
else do /* Need 1 layer to transform in */
call notify(1,'!'sysnam,'@Sorry, No Scratch Layer Available')
return
end
box=boundingbox()
parse var box n x1 x2 y1 y2 z1 z2
z2=z1+deep*2
call surface("Slab")
call MAKEBOX(x1 y1 z1, x2 y2 z2)
call smoothshift(wide)
call setblayer(txlayer)
call BOOLEAN(SUBTRACT)
call setlayer(txlayer)
call Cut()
call setlayer(slablayer)
call Cut()
call setlayer(txlayer)
call Paste()
return
Bevel_Flat:
return
Bevel_Block:
call bevel(0, deep / 2)
return
Bevel_Chisel:
call shapebevel(-wide wide (-wide) deep/2)
return
Bevel_Round:
n = 5
pat = ''
do i=1 to n
a = 3.14159/2 * i / n
pat = pat (-sin(a)*wide) (1-cos(a))*wide
end i
call shapebevel(pat (-wide) deep/2)
return
CreateText: PROCEDURE expose font wide styles deep just LineWidth
arg txt,typ
say txt typ
origl = curlayer()
empty = emptylayers()
if (words(empty) < 2) then do
call notify 1,syscode,"!Need at least two empty layers","!for this operation."
exit
end
sl1 = word(empty, 1)
sl2 = word(empty, 2)
sbase = ''
do i=1 to words(txt)
sbase = sbase || word(txt, i)
if length(sbase) >= 5 then leave
end
if length(sbase) > 15 then sbase = left(sbase, 15)
corners = 'B B S S S'
call setlayer sl1
w= maketext(txt, font, word(corners, typ), wide * 2)
call copy
call setlayer sl2
call paste
call sel_mode('user')
call sel_polygon('set')
interpret 'call Bevel_' || word(styles, typ)
call cut
call changesurface(sbase || "_Side")
call setlayer sl1 /* Get the correct faces from sl1. */
call changesurface(sbase || "_Face")
call flip
call cut
call setlayer sl2
call paste
call mirror(Z, -deep/2)
call mergepoints
x=JustifyX(LineWidth,just)
call cut
call setlayer origl
call paste
return x